home *** CD-ROM | disk | FTP | other *** search
/ HAKERIS 11 / HAKERIS 11.ISO / linux / system / LinuxConsole 0.4 / linuxconsole0.4install-en.iso / guile0.4.lcm / share / guile / slib / db2html.scm < prev    next >
Encoding:
Text File  |  2004-01-06  |  2.1 KB  |  58 lines
  1. ;"db2html.scm" Convert relational database to hyperlinked pages.
  2.  
  3. (require 'html-form)
  4. (require 'net-clients)
  5.  
  6. ;;@subsection HTML databases
  7.  
  8. ;;@code{(require 'db->html)}
  9.  
  10. ;;@body @1 must be a relational database.  @2 must be #f or a
  11. ;;non-empty string naming an existing sub-directory of the current
  12. ;;directory.
  13. ;;
  14. ;;@0 creates an html page for each table in the database @1 in the
  15. ;;sub-directory named @2, or the current directory if @2 is #f.  The
  16. ;;top level page with the catalog of tables (captioned @4) is written
  17. ;;to a file named @3.
  18. (define (db->files db dir index-filename caption)
  19.   (call-with-output-file (in-vicinity (if dir (sub-vicinity "" dir) "")
  20.                       index-filename)
  21.     (lambda (port)
  22.       (fluid-let ((*html:output-port* port))
  23.     (catalog->page db caption))))
  24.   ((((db 'open-table) '*catalog-data* #f) 'for-each-row)
  25.    (lambda (row)
  26.      (call-with-output-file 
  27.      (in-vicinity (sub-vicinity "" dir) (table-name->filename (car row)))
  28.        (lambda (port)
  29.      (fluid-let ((*html:output-port* port))
  30.        (table->page db (car row) index-filename)))))))
  31.  
  32. ;;@args db dir index-filename
  33. ;;@args db dir
  34. ;;@1 must be a relational database.  @2 must be a non-empty
  35. ;;string naming an existing sub-directory of the current directory or
  36. ;;one to be created.  The optional string @3 names the filename of the
  37. ;;top page, which defaults to @file{index.html}.
  38. ;;
  39. ;;@0 creates sub-directory @2 if neccessary, and calls
  40. ;;@code{(db->files @1 @2 @3 @2)}.  The @samp{file:} URL of @3 is
  41. ;;returned.
  42. (define (db->directory db dir . index-filename)
  43.   (set! index-filename (if (null? index-filename)
  44.                "index.html"
  45.                (car index-filename)))
  46.   (if (symbol? dir) (set! dir (symbol->string dir)))
  47.   (if (not (file-exists? dir)) (make-directory dir))
  48.   (db->files db dir index-filename dir)
  49.   (path->url (in-vicinity (sub-vicinity "" dir) index-filename)))
  50.  
  51. ;;@args db dir index-filename
  52. ;;@args db dir
  53. ;;@0 is just like @code{db->directory}, but calls
  54. ;;@code{browse-url-netscape} with the url for the top page after the
  55. ;;pages are created.
  56. (define (db->netscape . args)
  57.   (browse-url-netscape (apply db->directory args)))
  58.